SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00006 1 08-24-9413:48ALL OLAF BARTELT Netware Encrypted Login SWAG9408 ┘Y┬╛ 109 ,î π{$R+,V-}ππ{ This program will prompt for a server, login id and password. All }π{ input will be echoed to the screen! }ππPROGRAM LOGON;ππUSESπ Dos,π Crt;ππCONSTπ NET_USER = 1;π USER_GROUP = 2;π FILE_SERVER = 4;ππ MaxServers = 8;π DriveHandleTable = 0;π DriveFlagTable = 1;π DriveServerTable = 2;π ServerMapTable = 3;π ServerNameTable = 4;ππTYPEπ Buf32 = ARRAY [0..31] OF BYTE;π Buf16 = ARRAY [0..15] OF BYTE;π Buf8 = ARRAY [0..7] OF BYTE;π Buf4 = ARRAY [0..3] OF BYTE;ππCONSTπ EncryptTable : ARRAY [BYTE] OF BYTE =π($7,$8,$0,$8,$6,$4,$E,$4,$5,$C,$1,$7,$B,$F,$A,$8,π $F,$8,$C,$C,$9,$4,$1,$E,$4,$6,$2,$4,$0,$A,$B,$9,π $2,$F,$B,$1,$D,$2,$1,$9,$5,$E,$7,$0,$0,$2,$6,$6,π $0,$7,$3,$8,$2,$9,$3,$F,$7,$F,$C,$F,$6,$4,$A,$0,π $2,$3,$A,$B,$D,$8,$3,$A,$1,$7,$C,$F,$1,$8,$9,$D,π $9,$1,$9,$4,$E,$4,$C,$5,$5,$C,$8,$B,$2,$3,$9,$E,π $7,$7,$6,$9,$E,$F,$C,$8,$D,$1,$A,$6,$E,$D,$0,$7,π $7,$A,$0,$1,$F,$5,$4,$B,$7,$B,$E,$C,$9,$5,$D,$1,π $B,$D,$1,$3,$5,$D,$E,$6,$3,$0,$B,$B,$F,$3,$6,$4,π $9,$D,$A,$3,$1,$4,$9,$4,$8,$3,$B,$E,$5,$0,$5,$2,π $C,$B,$D,$5,$D,$5,$D,$2,$D,$9,$A,$C,$A,$0,$B,$3,π $5,$3,$6,$9,$5,$1,$E,$E,$0,$E,$8,$2,$D,$2,$2,$0,π $4,$F,$8,$5,$9,$6,$8,$6,$B,$A,$B,$F,$0,$7,$2,$8,π $C,$7,$3,$A,$1,$4,$2,$5,$F,$7,$A,$C,$E,$5,$9,$3,π $E,$7,$1,$2,$E,$1,$F,$4,$A,$6,$C,$6,$F,$4,$3,$0,π $C,$0,$3,$6,$F,$8,$7,$B,$2,$D,$C,$6,$A,$A,$8,$D);ππ EncryptKeys : Buf32 =π($48,$93,$46,$67,$98,$3D,$E6,$8D,$B7,$10,$7A,$26,$5A,$B9,$B1,$35,π $6B,$0F,$D5,$70,$AE,$FB,$AD,$11,$F4,$47,$DC,$A7,$EC,$CF,$50,$C0);πππTYPEπ WORD = INTEGER;ππ NetStr = STRING[47];π GenStr = STRING[128];π FourBytes = ARRAY [1..4] of BYTE;π MemBlock = ARRAY [1..128] OF CHAR;ππ{ RegsType = RECORD case integer ofπ 1: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : INTEGER);π 2: (AL, AH, BL, BH, CL, CH, DL, DH : BYTE);π END; }ππ ServerItem = ARRAY [1..48] OF CHAR;π ServerName = ARRAY[1..MaxServers] OF ServerItem;π ServerNamePtr = ^ServerName;ππ ServerMappingEntry = RECORDπ SlotInUse : BYTE;π OrderNumber : BYTE;π ServerNet : ARRAY [1..10] OF CHAR;π ServerSocket : WORD;π RouterNet : ARRAY [1..10] OF CHAR;π RouterSocket : WORD;π ShellInternal : ARRAY [1..6] OF CHAR;π END;ππ ServerMappingTable = ARRAY [1..MaxServers] OF ServerMappingEntry;π ServerMappingPtr = ^ServerMappingTable;ππVARπ rc : BYTE;π Regs : Registers;π { Regs : RegsType; }ππ{ -------------------------------------------------------------- }ππFUNCTION GetString(VAR NameEntry: ServerItem): GenStr;πVAR tmp: GenStr;π i: INTEGER;π ct: BYTE;πBEGINπ i := 1;π ct := 0;ππ WHILE NameEntry[i] <> CHR(0) DOπ BEGINπ tmp[i] := NameEntry[i];π i := i + 1;π ct := ct + 1;π END;ππ tmp[0] := CHAR(ct);π GetString := tmp;π END;ππPROCEDURE Str2Az(st: GenStr; VAR az; size: INTEGER);πVAR p: ^BYTE;πBEGINπ Fillchar(az, size+1, 0);π p := ADDR(st[1]);π Move(p^, az, size);π END;ππPROCEDURE DefaultRegs(VAR r: Registers);πBEGINπ r.DS := DSeg;π r.ES := DSeg;π{ r.AX := 0;π r.BX := 0;π r.CX := 0;π r.DX := 0;π r.BP := 0;π r.SI := 0;π r.DI := 0; }π END;ππFUNCTION FileServiceRequest( func: BYTE;π VAR q; qlen: WORD;π VAR reply; rlen: WORD): BYTE;πBEGINπ DefaultRegs(Regs);π Regs.DS := Seg(q);π Regs.SI := Ofs(q);π Regs.CX := qlen;π Regs.ES := Seg(reply);π Regs.DI := Ofs(reply);π Regs.DX := rlen;π Regs.AH := $F2;π Regs.AL := func;π MSDOS(Regs);π FileServiceRequest := Regs.AL;πEND;ππFUNCTION CallNetware(RegAH : BYTE; VAR request, reply): BYTE;πBEGINπ DefaultRegs(Regs);π Regs.AH := RegAH;π Regs.DS := Seg(request);π Regs.SI := Ofs(request);π Regs.ES := Seg(reply);π Regs.DI := Ofs(reply);π MSDOS(Regs);π CallNetware := Regs.AL;π END;ππPROCEDURE UpcaseStr(VAR s: GenStr);πVAR i : INTEGER;πBEGINπ for i := 1 to Length(s) doπ Beginπ s[i] := UpCase(s[i]);π End;π END;ππFUNCTION GetServerMappingPtr : ServerMappingPtr;πVAR TmpPtr: ServerMappingPtr;πBEGINπ DefaultRegs(Regs);π Regs.AX := $EF03;π MSDOS(Regs);π TmpPtr := Ptr(Regs.ES, Regs.SI);π GetServerMappingPtr := TmpPtr;π END;ππFUNCTION GetServerNamePtr : ServerNamePtr;πVAR TmpPtr: ServerNamePtr;πBEGINπ DefaultRegs(Regs);π Regs.AX := $EF04;π MSDOS(Regs);π TmpPtr := Ptr(Regs.ES, Regs.SI);π GetServerNamePtr := TmpPtr;π END;ππFUNCTION GetServerNumber(s: NetStr): BYTE;πVARπ t : ServerNamePtr;π m : ServerMappingPtr;π i : INTEGER;πBEGINπ m := GetServerMappingPtr;π t := GetServerNamePtr;π UpCaseStr(s);ππ FOR i:=1 TO MaxServers DO BEGINπ IF (m^[i].SlotInUse = $FF) AND (GetString(t^[i]) = s) THEN BEGINπ GetServerNumber := i;π Exit;π END;π END;π GetServerNumber := 0;πEND;ππFUNCTION ReadPropertyValue(ObjectType : WORD; ObjectName : NetStr;π Segnr : BYTE; Property : NetStr;π VAR item): BYTE;πVARπ req : RECORDπ plen : WORD;π func : BYTE;π otype : WORD;π Filler : GenStr;π END;π rep : RECORDπ plen : WORD;π Data : ARRAY [1..128] OF BYTE;π More : BYTE;π PropFlags : BYTE;π END;ππBEGINπ req.func := 61;π req.otype := Swap(ObjectType);π req.plen := Length(ObjectName) +π Length(Property) + 6;π req.filler := ObjectName + Char(Segnr) +π Char(Length(Property)) +π Property;π req.filler[0] := Char(Length(ObjectName));π rep.plen := SizeOf(rep) - 2;π ReadPropertyValue := CallNetware($E3,req,rep);π Move(rep.data, item, SizeOf(rep.data) + 2);πEND;ππFUNCTION InsertServer(Name : NetStr):BYTE;πVARπ MapPtr : ServerMappingPtr;π NamePtr : ServerNamePtr;π res : BYTE;π free,i : INTEGER;π data : ARRAY [1..130] OF BYTE;ππ FUNCTION LowerAddr(VAR a, b): BOOLEAN;π TYPEπ Net_Address = ARRAY [1..10] OF CHAR;π VARπ a_addr : Net_Address ABSOLUTE a;π b_addr : Net_Address ABSOLUTE b;π BEGINπ LowerAddr := a_addr < b_addr;π END;ππBEGINπ UpCaseStr(Name);π IF GetServerNumber(Name) <> 0 THEN BEGINπ InsertServer := 0;π Exit;π END;ππ res := ReadPropertyValue(FILE_SERVER, name, 1, 'NET_ADDRESS', data);π IF res <> 0 THEN BEGINπ InsertServer := $7D;π Exit;π END;ππ MapPtr := GetServerMappingPtr;π free := 1;π WHILE (MapPtr^[free].SlotInUse = $FF) DO BEGINπ free := free + 1;π IF free > MaxServers THEN BEGINπ InsertServer := $7C;π Exit;π END;π END;ππ NamePtr := GetServerNamePtr;π WITH MapPtr^[free] DO BEGINπ Move(data, ServerNet, 12);π Str2Az(name, NamePtr^[free], SizeOf(NamePtr^[free]));π OrderNumber := 1;π FOR i := 1 TO MaxServers DO BEGINπ IF MapPtr^[i].SlotInUse = $FF THEN BEGINπ IF LowerAddr(MapPtr^[i].ServerNet, ServerNet) THENπ OrderNumber := OrderNumber + 1π ELSEπ MapPtr^[i].OrderNumber := MapPtr^[i].OrderNumber + 1;π END;π END;π SlotInUse := $FF;π END;π InsertServer := 0;πEND;ππFUNCTION AttachServerNumber(func : BYTE; sn : BYTE) : BYTE;πBEGINπ DefaultRegs(Regs);π Regs.ah := $F1;π Regs.al := func;π Regs.dl := sn;π MSDOS(Regs);π AttachServerNumber := Regs.al;πEND;ππFUNCTION AttachServer(func : BYTE; name : NetStr) : BYTE;πVARπ sn : BYTE;πBEGINπ sn := GetServerNumber(name);π IF sn = 0 THEN BEGINπ AttachServer := $7B;π Exit;π END;π AttachServer := AttachServerNumber(func,sn);πEND;πππFUNCTION GetEffectiveServer:BYTE;πBEGINπ DefaultRegs(Regs);π Regs.ax := $F002;π MSDOS(Regs);π GetEffectiveServer := Regs.al;πEND;ππPROCEDURE SetPrimaryServer(sno:BYTE);πBEGINπ DefaultRegs(Regs);π Regs.ax := $F004;π Regs.dl := sno;π MSDOS(Regs);πEND;ππFUNCTION GetPrimaryServer:BYTE;πBEGINπ DefaultRegs(Regs);π Regs.ax := $F005;π MSDOS(Regs);π GetPrimaryServer := Regs.al;πEND;ππFUNCTION SetPreferredServer(sno: BYTE): BYTE;πBEGINπ DefaultRegs(Regs);π Regs.ax := $F000;π Regs.dl := sno;π MSDOS(Regs);π Regs.ax := $F001;π MSDOS(Regs);π SetPreferredServer := Regs.AL;πEND;ππFUNCTION MapNameToNumber(ObjectType : WORD;ObjectName : NetStr;π VAR ObjectID : FourBytes): BYTE;πVARπ req : RECORDπ plen : WORD;π func : BYTE;π otype : WORD;π name : NetStr;π END;π rep : RECORDπ plen : WORD;π objID : FourBytes;π otype : WORD;π name : ARRAY [1..48] OF CHAR;π END;πBEGINπ req.func := 53; {Get an object's number}π req.otype := Swap(ObjectType);π req.name := ObjectName;π req.plen := Length(ObjectName) + 4;π rep.plen := SizeOf(rep) - 2;π MapNameToNumber := CallNetware($E3, req, rep);π ObjectID := rep.objID;πEND;ππFUNCTION MapNumberToName(ID : FourBytes; VAR Name; VAR Otype : WORD):BYTE;πVARπ req : RECORDπ plen : WORD;π func : BYTE;π OID : FourBytes;π END;π rep : RECORDπ plen : WORD;π OID : FourBytes;π otyp : WORD;π Oname : ServerItem;π END;π nam : NetStr ABSOLUTE Name;πBEGINπ req.func := 54; {Get an object's name}π req.OID := ID;π req.plen := SizeOf(req) - 2;π rep.plen := SizeOf(rep) - 2;π MapNumberToName := CallNetware($E3,req,rep);π Nam := GetString(rep.OName);π Otype:= Swap(rep.Otyp);πEND;ππFUNCTION LoginAnObject( Name:NetStr; Otype:WORD; Passw: NetStr):BYTE;πVARπ req : RECORDπ plen : WORD;π func : BYTE;π otype : WORD;π NamePass : STRING[96];π END;π rep : RECORDπ plen : WORD;π END;πBEGINπ req.plen := 5 + Length(Name) + Length(Passw);π req.func := 20;π UpCaseStr(Passw);π UpCaseStr(Name);π req.otype := Swap(otype);π req.NamePass:=Name;π Move(Passw, req.NamePass[Length(Name)+1], Length(Passw) + 1);π rep.plen := 0;π LoginAnObject := CallNetware($E3, req, rep);πEND;ππFUNCTION LoginUser(Name, Password: NetStr): BYTE;πVARπ req : RECORDπ plen : INTEGER;π func : BYTE;π NamePass : STRING[96];π END;π rep : RECORDπ plen : INTEGER;π END;ππBEGINπ req.plen := 3 + Length(Name) + Length(Password);π req.func := 0;π UpcaseStr(Password);π UpcaseStr(Name);π req.NamePass := Name;π Move(Password, req.NamePass[Length(Name)+1], Length(Password)+1);π rep.plen := 0;π LoginUser := CallNetware($E3, req, rep);πEND;ππFUNCTION GetEncryptionKey(VAR key : Buf8): BYTE;πVARπ q : RECORDπ plen : WORD;π func : BYTE;π END;πBEGINπ q.plen := 1;π q.func := $17;π GetEncryptionKey := FileServiceRequest($17, q, SizeOf(q), key, SizeOf(key));πEND;ππFUNCTION LoginEncrypted(name : NetStr; otype : WORD; VAR key : Buf8): BYTE;πVARπ a : RECORDπ plen : WORD;π func : BYTE;π key : Buf8;π otyp : WORD;π name : NetStr;π END;πBEGINπ a.plen := Length(name) + 12;π a.func := $18;π a.key := key;π a.otyp := Swap(otype);π a.name := name;π LoginEncrypted := FileServiceRequest($17, a, Length(name)+14, Mem[0:0], 0);πEND;ππPROCEDURE Shuffle1(VAR temp : Buf32; VAR target);πVARπ t : Buf16 ABSOLUTE target;π b4 : WORD;π b3 : BYTE;π s, d, b2, i : WORD;πBEGINπ b4 := 0;π FOR b2 := 0 TO 1 DO BEGINπ FOR s := 0 TO 31 DO BEGINπ b3 := Lo(Lo(temp[s] + b4)π XOR Lo(temp[(s + b4) AND 31]π - EncryptKeys[s]));π b4 := b4 + b3;π temp[s] := b3;π END;π END;ππ FOR i := 0 TO 15 DOπ t[i] := EncryptTable[temp[i Shl 1]]π OR (EncryptTable[temp[i Shl 1 +1]] Shl 4);πEND;ππPROCEDURE Shuffle(VAR lon, buf; buflen : WORD; VAR target);πVARπ l : Buf4 ABSOLUTE lon;π b : ARRAY [0..127] OF BYTE ABSOLUTE buf;π b2 : WORD;π temp : Buf32;π s, d : WORD;πBEGINπ IF buflen > 0 THENπ WHILE (buflen > 0) AND (b[buflen-1] = 0) DOπ buflen := buflen - 1;ππ FillChar(temp, SizeOf(temp), #0);ππ d := 0;π WHILE buflen >= 32 DO BEGINπ FOR s := 0 TO 31 DO BEGINπ temp[s] := temp[s] XOR b[d];π d := d + 1;π END;π buflen := buflen - 32;π END;π b2 := d;ππ IF buflen > 0 THEN BEGINπ FOR s := 0 TO 31 DO BEGINπ IF d + buflen = b2 THEN BEGINπ b2 := d;π temp[s] := temp[s] XOR EncryptKeys[s];π ENDπ ELSE BEGINπ temp[s] := temp[s] XOR b[b2];π b2 := b2 + 1;π END;π END;π END;π FOR s := 0 TO 31 DOπ temp[s] := temp[s] XOR l[s AND 3];ππ Shuffle1(temp, target);πEND;ππPROCEDURE Encrypt(VAR fra, buf, til);πVARπ f : Buf8 ABSOLUTE fra;π t : Buf8 ABSOLUTE til;π k : Buf32;π s : WORD;πBEGINπ Shuffle(f[0], buf, 16, k[0]);π Shuffle(f[4], buf, 16, k[16]);π FOR s := 0 TO 15 DOπ k[s] := k[s] XOR k[31-s];π FOR s := 0 TO 7 DOπ t[s] := k[s] XOR k[15-s];πEND;ππFUNCTION LoginToFileServer(name: NetStr; otype: WORD; passw: GenStr): BYTE;πVARπ key : Buf8;π id : FourBytes;π buf : Buf32;π res : BYTE;ππBEGINπ UpCaseStr(passw);π res := GetEncryptionKey(key);π IF res = 0 THEN BEGINπ res := MapNameToNumber(otype, name, id);π IF res = 0 THEN BEGINπ Shuffle(id, passw[1], Length(passw), buf);π Encrypt(key, buf, key);π res := LoginEncrypted(name, otype, key);π END;π ENDπ ELSE BEGINπ res := LoginAnObject(name, otype, passw);π END;ππ LoginToFileServer := res;πEND;ππFUNCTION Login(Sname, OName : NetStr; OType : WORD; Passw : NetStr) : BYTE;πVARπ sn, res, rc : BYTE;π Curr_Server : BYTE;πBEGINπ UpCaseStr(SName);π sn := GetServerNumber(Sname);ππ IF sn = 0 THEN BEGINπ res := InsertServer(SName);π IF res <> 0 THEN BEGINπ Login := res;π Exit;π END;π sn := GetServerNumber(SName);π END;ππ res := AttachServerNumber(0, sn);π IF res <> 0 THEN BEGINπ Login := res;π Exit;π END;ππ Curr_Server := GetEffectiveServer;π IF SetPreferredServer(sn) = sn THENπ rc := LoginToFileServer(OName, Otype, Passw)π ELSEπ rc := $7A;ππ res := SetPreferredServer(Curr_Server);π Login := rc;πEND;ππBEGINπ IF ParamCount <> 3 THEN BEGINπ Writeln('Please supply server name, your user id, and a password.');π Exit;π END;ππ rc := Login(ParamStr(1), ParamStr(2), NET_USER, ParamStr(3));ππ IF rc <> 0 THEN BEGINπ Writeln('Login failed.');π Exit;π END;ππ END.ππ 2 08-24-9413:49ALL NORBERT IGL Encryped logins SWAG9408 äf
╓ 23 ,î {π SM> Have you got any idea on how to do a login under Novell 3.11+?ππ SM> I have some source (SWAG has source for a great TPU), butπ SM> unfortunatly it doesn't do encrypted logins.. I managed to findπ SM> *some* reference to it in the interrupt list (int 21h, the F2hπ SM> multiplexor functions 17h/18h), but it didn't give any details onπ SM> how this is done...ππ hmmm. Novell never released any informations about Password Encrytion !ππ You got two choices (:-)ππ1. do a "Set Allow Unencrypted Passwords = ON" on the server console,π use the following, ripped from an old src "Novapi.zip:Novell.pas"ππ------------------------------------------------------------------------}πuses dos;π[...]ππ{ obj_type: User = 1, group =2 printserver = 3 }ππprocedure login_to_file_server( obj_type:integer;π _name,π _password : string;π var retcode:integer);πvarπ regs : registers;ππ request_buffer : recordπ B_length : integer;π subfunction : byte;π o_type : packed array [1..2] of byte;π name_length : byte;π obj_name : packed array [1..47] of byte;π password_length : byte;π password : packed array [1..27] of byte;π end;ππ reply_buffer : recordπ R_length : integer;π end;ππ count : integer;ππbeginπWith request_buffer doπbeginπ B_length := 79;π subfunction := $14;π o_type[1] := 0;π o_type[2] := obj_type;π for count := 1 to 47 do obj_name[count] := $0;π for count := 1 to 27 do password[count] := $0;π if length(_name) > 0 thenπ for count := 1 to length(_name) doπobj_name[count]:=ord(upcase(_name[count]));π if length(_password) > 0 thenπ for count := 1 to length(_password) doπpassword[count]:=ord(upcase(_password[count]));π {set to full length of field}π name_length := 47;π password_length := 27;πend;πWith reply_buffer doπbeginπ R_length := 0;πend;π With Regs Do Beginπ Ah := $e3; { moved to $F2 for v3.x ??? }π Ds := Seg(Request_Buffer);π Si := Ofs(Request_Buffer);π Es := Seg(reply_buffer);π Di := Ofs(reply_buffer);π End;π MsDos(Regs);π retcode := regs.alπend;ππprocedure logout;π{logout from all file servers}πvar regs : registers;πbeginπ regs.ah := $D7;π msdos(regs);πend;ππprocedure logout_from_file_server(var id: integer);π{logout from one file server}πvar regs : registers;πbeginπ regs.ah := $F1;π regs.al := $02;π regs.dl := id;π msdos(regs);πend;ππ------------------------------------------------------------------------ππ2. get a copy of "Charles Rose: Netware Programming". There are someπ <obj> for "C", and in my German version TPU's for Turbo/BP" !ππ 3 08-24-9413:49ALL KLAUS WIEGAND Network Options SWAG9408 èm'ë 51 ,î {π> I'm looking for information and or code (pascal pref) on the theπ> following network options:π>π> 1. A routine to determine if Novel IPX is available (active/loaded)}ππ(*--------------------------------------------------------------------------*)π(* IsNovellActive --- Checks if Novell network is active *)π(*--------------------------------------------------------------------------*)ππFUNCTION IsNovellActive : BOOLEAN;ππ(*--------------------------------------------------------------------------*)π(* *)π(* Function: IsNovellActive *)π(* *)π(* Purpose: Checks if Novell network active *)π(* *)π(* Calling Sequence: *)π(* *)π(* Novell_On := IsNovellActive : BOOLEAN; *)π(* *)π(* Novell_On --- TRUE if Novell network is active. *)π(* *)π(* Calls: MsDos *)π(* *)π(*--------------------------------------------------------------------------*)ππVARπ Regs : Registers;ππBEGIN (* IsNovellActive *)ππ Regs.CX := 0;π Regs.AL := 0;π (* Request workstation ID. *)π (* This should be ignored if Novell *)π (* network software isn't active. *)π Regs.AH := $DC;ππ MsDos( Regs );π (* If we got back a non-zero station *)π (* ID, then Novell must be loaded. *)ππ IsNovellActive := ( Regs.AL <> 0 );ππEND (* IsNovellActive *);πππ(* ************** second method ******************** *)ππuses dos ;πvar Regs : registers ;π ReplyBuffer : array[1..40] of char ;πππfunction IPX_Loaded:boolean;πbeginπ Regs.AX := $7A00 ;π intr($2F,Regs) ;π IPX_Loaded := (Regs.AL = $FF)πend;ππfunction Netbios_Loaded:Boolean;πbeginπ Regs.AH := $35; (* DOS function that checks an interrupt vector *)π Regs.AL := $5C; (* Interrupt vector to be checked *)π NetBios_Installed := True;π msdos(Regs) ;π if ((Regs.ES = 0) or (Regs.ES = $F000))π then NetBios_Installed := Falseπend;πππfunction NetShell_Installed:Boolean;πbeginπ with Regs do beginπ AH := $EA ;π AL := 1 ;π BX := 0 ;π ES := seg(ReplyBuffer) ;π DI := ofs(ReplyBuffer) ;π end ; (* with do begin *)π msdos(regs) ;π NetShell_Installed := (Regs.BX = 0)πend.π{π> 3. I'm looking for any available NetBIOS-compatible routines whichπ> will yield a "connection number" (not a username or node id). I'mπ> under the impression that this ability is not available via NetBIOS.π> Is this true?π}ππuses dos;πtypeππ DayOfTheWeek = (Sunday,Monday,Tuesday,Wednesday,Thursday,π Friday,Saturday);π NovDateType = recordπ Year, {80=1980}π Month,π Day,π Hour,π Minute,π Second : Byte;π WeekDay : DayOfTheWeek;π Filler : Byte; {!!.03}π end;π ConnInfoType = recordπ ObjectID : LongInt; {the logged in object's ID}π ObjectType : Word; {the logged object's type}π ObjectName : String[48]; {the name of the object}π LoginDate : NovDateType; {the time/date the object}π {logged on to connection}π end;ππfunction NetWareSwapLong(L : LongInt) : LongInt;πInline(π $5A/ { pop dx}π $86/$D6/ { xchg dh,dl}π $58/ { pop ax}π $86/$C4); { xchg ah,al}ππfunction AsciiZ2Str(var Buffer; Max : Byte) : String;πconstπ AsciiZMAX = 255;ππtypeπ AsciiZBuffer = Array[1..AsciiZMAX] of Char;ππvarπ A : AsciiZBuffer absolute Buffer;π I : Word;π S : String;ππbeginπ I := 1;π { search for terminating #0, stop if max string length exceeded}π while (A[I] <> #0) and (I < Max) do beginπ S[I] := A[I];π Inc(I);π end;π S[0] := Char(I-1);π AsciiZ2Str := S {return the string}πend;ππππfunction GetConnNo : Byte;πvarπ Regs : dos.Registers;πbeginπ regs.AX := $DC00;π intr($21,Regs);π GetConnNo := Regs.ALπend;πprocedure GetConnInfo(ConnNo : Byte; var ConnInfo : ConnInfoType);πvarπ Regs : dos.Registers;π Request : recordπ Len : Word;π SubF : Byte;π Conn : Byte;π end;π Reply : recordπ Len : Word;π ID : LongInt;π ObjType : Word;π ObjName : Array[1..48] of Char;π Time : NovDateType;π end;πbeginπ Reply.Len := SizeOf(Reply) - 2; {!!.03}π Request.Len := 2;π Request.SubF := $16;π Request.Conn := ConnNo;π Regs.AH := $E3;π Regs.DS := Seg(Request); {DS:SI points to request}π Regs.SI := Ofs(Request);π Regs.ES := Seg(Reply); {ES:DI points to reply}π Regs.DI := Ofs(Reply);π intr($21,Regs);π with ConnInfo do beginπ ObjectID := NetWareSwapLong(Reply.ID);π ObjectType := Swap(Reply.ObjType);π ObjectName := AsciiZ2Str(Reply.ObjName,48);π LoginDate := Reply.Time;π end;πend;ππvarπConnInfo: ConnInfoType;ππbeginπ GetConnInfo(GetConnNo,ConnInfo);π with ConnInfo doπ beginπ WriteLn('ID: ',ObjectId);π WriteLn('Type: ',ObjectType);π WriteLn('Name: ',ObjectName);π WriteLn('Time: ',Logindate.hour:2,':',Logindate.second);π end;πend.π 4 08-25-9409:04ALL ROBIN BOWES Call NETAPI.DLL function SWAG9408 ┴╒r₧ 32 ,î (*πFrom: ROBIN@plato.ucsalf.ac.uk (Robin Bowes)ππI'm trying to call a function in a Windows .dll fromπTurbo Pascal for Windows v1.5.ππThe .dll in question is NETAPI.DLL. The function I want to call isπdefined as follows (in C format):ππ(from Microsoft LAN Manager Programmer's Reference, )ππNetWkstaGetInfo ( const char far * pszServer,π short sLevel,π char far * pbBuffer,π unsigned short cbBuffer,π unsigned short far * pcbTotalAvailπ );ππwhereππpszServerπ contains the name of the server on which to execute NetWkstGetInfo.ππsLevelπ specfies the level of detail to be supplied in the return bufferππpbBufferπ points to the buffer in which data is returnedππcbBufferπ specifies the size of the buffer pointed to by pbBufferππpcbTotalAvailπ points to an unsigned integer in which the number of bytes ofπ information available is returned.πππThe detail level I require is 10 which means that the buffer returnedπwill contain a wksta_info_10 structure which is defined as follows:ππstruct wksta_info_10 {π char far * wki10_computername;π char far * wki10_username;π char far * wki10_langroup;π unsigned char wki10_ver_major;π unsigned char wki10_ver_minor;π char far * wki10_logon_domain;π char far * wki10_oth_domains;π};πππI am having trouble getting this function to work. It will be a .dllπeventually but for now I'm jsut coding it as a program using WinCrt.ππMy code so far looks something like this:π*)πprogram Username;ππuses WinTypes, WinCrt;ππconstπ NERR_BufTooSmall = 2123;π NERR_Success = 0;ππtypeπ Wksta_info_10 =π recordπ wki10_computername : pChar;π wki10_username : pChar;π wki10_langroup : pChar;π wki10_ver_major : Byte;π wki10_ver_minor : Byte;π wki10_logon_domain : pChar;π wki10_oth_domains : pChar;π end;π pWksta_info_10 = ^Wksta_info_10;ππfunction NetWkstaGetInfo( pszServer : pChar;π sLevel : Integer;π var pbBuffer : pWksta_info_10;π cbBuffer : Word;π var pcbTotalAvail : pWordπ ) : Integer; far; external 'NETAPI';ππfunction getUsername(var Username : pChar) : Integer;πvarπ pWI : pWksta_info_10;π sWorkStationInfo : Word;π pbBufLen : pWord;π pbTotalAvail : pWord;π uRetCode : Integer;ππbeginπ {first call will fail but should return the size of theπ buffer needed to hold all the available data}π getMem(pbBufLen, sizeOf(pbBufLen));π pwI := nil;π uRetCode := NetWkstaGetInfo(nil, {Servername (nil -> local machine)}π 10, {Reporting level} π pWI, {target buffer for info}π 0, {Size of target buffer}π pbBufLen {Count of bytes available}π );π {check the return code from the function}π if (uRetCode = NERR_BufTooSmall) thenπ { check available memory }π beginπ if maxAvail < pbBufLen^ thenπ beginπ getUsername := -1;π Exitπ endπ elseπ {allocate memory for buffer to hold information}π beginπ getMem(pWI, pbBufLen^)π endπ endπ elseπ {Unexpected error returned}π beginπ {Pass return code back to calling program}π getUsername := uRetCode;π Exitπ end;ππ {second call to get information}π getMem(pbTotalAvail, sizeOf(pbTotalAvail));π uRetCode := NetWkstaGetInfo(nil, 10, pWI, pbBufLen^, pbTotalAvail);π getUsername := uRetCode;π if uRetCode = NERR_Success thenπ beginπ Username := pWI^.wki10_username;π end;π freeMem(pbBufLen, sizeOf(pbBufLen));π freeMem(pbTotalAvail, sizeOf(pbTotalAvail))πend;ππ{exportsπ getUsername index 1;}ππvarπ retVal : Integer;π uName : pChar;ππbeginπgetMem(uName, sizeOf(uName));πretVal := getUserName(uName);πif retVal = NERR_Success thenπ writeln(uName)πelseπ writeln('Error returned: ', retVal);πfreeMem(uName, sizeOf(uName));πend.π{ππThis compiles OK but throws a GPF in NETAPI.DLL.ππI'm fairly sure it's the conversion of the structure type that's causingπthe problem.ππHas anybody got any ideas ?ππ} 5 08-25-9409:09ALL MICHAEL HOENIE Networking SWAG9408 MF²º 64 ,î {πI'm still looking for help with these networking routines. I've revisedπthem again to make a full standing unit. This NETWORK unit will compileπstand-alone with TP 6.0. I still get an error 162 when using theseπroutines, which from the manual says MACHINE FAILURE or hardware. I haveπrun it on at least 10 different machines and get the same problem.ππIf *ANYONE* has a better way of keeping another node from accessing aπfile, please, PLEASE let me know! I have an ENTIRE project (10,000+πlines) on hold until I get these networking routines done.π}π UNIT NETWORK;ππ interface uses dos;ππ constπ max_timeout=10; { seconds to time out on network timeout }π max_nodes=25;ππ typeπ string80=string[80];π networkrecord=record { basic makeup of the actual user }π x_username:string[5]; { network name of user }π x_active:boolean; { * IMPORTANT * : if node is active }π end;ππ varπ netfile:file of networkrecord;π netdata:networkrecord;π network_node:integer;π time1,time2,time3,date1,date2,date3:string[15];π incom,incom1,out,out1:string[255];π _retval:integer;π _retbol:boolean;ππ function network_exist(filename1:string80):byte;π procedure node_status(filename1:string80);π procedure lock_file(filename2:string80);π procedure unlock_file(filename3:string80);π procedure make_nodes;π procedure update_node;π procedure log_node;π procedure log_off_node;ππ implementationππ(*═════════════════════════════════════════════════════════════════════════*)ππ procedure timedate;π varπ ax1,ax2,ax3,ax4:word;π year,month,mil,day,hour,hour1,minute,second:string[20];π beginπ time1:=''; { 22:00:00 }π date1:=''; { 03/03/88 }π time2:=''; { 02:03am }π time3:=''; { 00:00 }π date2:=''; { wednesday, january 25th, 1988 }π gettime(ax1,{ hour } ax2,{ minute } ax3, { second }ax4); { milli-second }π str(ax1,hour);π if ax1<=12 then str(ax1,hour1) else str(ax1-12,hour1);π if length(hour1)=1 then insert('0',hour1,1);π str(ax2,minute);π str(ax3,second);π if length(minute)=1 then insert('0',minute,1);π if length(second)=1 then insert('0',second,1);π if length(hour)=1 then insert('0',hour,1);π time1:=hour+':'+minute+':'+second;π case ax1 ofπ 0..11:out1:='AM'π else out1:='PM';π end;π time2:=hour1+':'+minute+' '+out1;π time3:=hour1+':'+minute;π getdate(ax1, { year }ax2, { month }ax3, { day }ax4);{ day of week }π str(ax3,day);π if length(day)=1 then insert('0',day,1);π str(ax1,year);π str(ax2,month);π if length(month)=1 then insert('0',month,1);π date1:=month+'-'+day+'-'+copy(year,3,2);π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ function network_exist(filename1:string80):byte;π varπ net_file:file;π beginπ network_exist:=$0;π assign(net_file,filename1);π {$i-} reset(net_file) {$i+};π case ioresult ofπ 0:close(net_file);π 1:network_exist:=$1; { nothing }π 2:network_exist:=$2; { file not found }π 5:network_exist:=$5; { access denied }π end;π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ procedure node_status(filename1:string80);π varπ do_wait:boolean;π s_time,c_time:string[2];π d_timeout,d_wait,d_count:integer;π _retbyte:byte;π erfile:text;π beginπ filename1:=filename1+'.lck';π do_wait:=false;π timedate;π s_time:=copy(time1,7,2);π d_wait:=0;π d_timeout:=0;π while not do_wait doπ beginπ _retbyte:=network_exist('LOCK\'+filename1);π case _retbyte ofπ $0:write('.');π $5:write('.');π $1:do_wait:=true;π $2:do_wait:=true;π end;π if do_wait=true then d_timeout:=0;π timedate;π c_time:=copy(time1,7,2);π if c_time<>s_time thenπ beginπ s_time:=c_time;π d_count:=d_count+1;π d_timeout:=d_timeout+1;π end;π if d_timeout>max_timeout thenπ beginπ writeln('NETWORK TIMEOUT... NOTE_STATUS');π halt;π end;π end;π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ procedure lock_file(filename2:string80);π varπ fvar2:text;π beginπ if pos('.',filename2)>0 thenπ delete(filename2,pos('.',filename2),length(filename2));π filename2:=filename2+'.LCK';π node_status(filename2);π assign(fvar2,'LOCK\'+filename2);π rewrite(fvar2);π write(fvar2,'A');π close(fvar2);π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ procedure unlock_file(filename3:string80);π varπ fvar3:text;π beginπ if pos('.',filename3)>0 thenπ delete(filename3,pos('.',filename3),length(filename3));π filename3:=filename3+'.LCK';π if network_exist('LOCK\'+filename3)=$0 thenπ beginπ assign(fvar3,'LOCK\'+filename3);π erase(fvar3);π end;π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ procedure make_nodes;π beginπ case network_exist('LOCK\'+'NETWORK.SYS') ofπ $2:beginπ lock_file('NETWORK');π assign(netfile,'LOCK\'+'NETWORK.SYS');π rewrite(netfile);π netdata.x_username:='';π netdata.x_active:=false;π for _retval:=0 to max_nodes doπ beginπ seek(netfile,_retval);π write(netfile,netdata);π end;π close(netfile);π unlock_file('NETWORK');π end;π end;π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ procedure update_node;π beginπ with netdata doπ beginπ x_username:='MSH';π x_active:=true;π end;π lock_file('NETWORK');π assign(netfile,'LOCK\'+'NETWORK.SYS');π {$i-} reset(netfile); {$i+}π if ioresult>=1 thenπ beginπ writeln('NETWORK ERROR: UPDATE_NODE');π halt;π end;π seek(netfile,network_node);π write(netfile,netdata);π close(netfile);π unlock_file('NETWORK');π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ procedure log_node;π beginπ network_node:=-1;π lock_file('NETWORK');π assign(netfile,'LOCK\'+'NETWORK.SYS');π {$i-} reset(netfile) {$i+};π if ioresult>=1 thenπ beginπ writeln('NETWORK ERROR: LOG_NODE');π halt;π end;π for _retval:=filesize(netfile)-1 downto 0 doπ beginπ seek(netfile,_retval);π {$i-} read(netfile,netdata); {$i+}π if ioresult>=1 thenπ beginπ writeln('NETWORK ERROR: LOG_NODE');π halt;π end;π if NOT netdata.x_active then network_node:=_retval;π end;π if network_node=-1 thenπ beginπ writeln('NETWORK ERROR: LOG_NODE');π halt;π end;π seek(netfile,network_node);π write(netfile,netdata);π close(netfile);π unlock_file('NETWORK');π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ procedure log_off_node;π beginπ lock_file('NETWORK');π assign(netfile,'LOCK\'+'NETWORK.SYS');π {$i-} reset(netfile) {$i+};π if ioresult>=1 thenπ beginπ writeln('NETWORK ERROR: LOG_OFF_NODE');π halt;π end;π netdata.x_username:='';π netdata.x_active:=false;π seek(netfile,network_node);π write(netfile,netdata);π close(netfile);π unlock_file('NETWORK');π end;ππ(*═════════════════════════════════════════════════════════════════════════*)ππ END.π 6 08-25-9409:10ALL KEVIN R. PIERCE Novell Reading SWAG9408 Añ╡ 18 ,î Unit Litl_Nov;ππ(**********************************************************************)π(* by Kevin R. Pierce *)π(* December 29, 1991 *)π(* Kev1n@aol.com *)π(**********************************************************************)πinterfaceππtypeπ LoginTime = array[0..6] of byte;ππ ConnectionInfo = recordπ Object_ID : longint;π Object_Type : word;π Object_Name : array[1..48] of char;π Login_Time : LoginTime;π ApplicationNumber : word; {swap & display Hex}π end;ππ CnxnInfoREQUEST = recordπ ReqBuffLen : word; {always = 2}π Mask : byte; {always = 16h}π CnxnNo : byte; { >1 }π end;ππ CnxnInfoREPLY = recordπ RepBuffLen : word; {always = SIZEOF(ConnectionInfo) }π Data : ConnectionInfo;π end;πππfunction NOV_GetConnectionNumber:integer;πprocedure NOV_GetConnectionInformation(connection:byte; varπResult:ConnectionInfo);ππ(**********************************************************************)πimplementationππusesπ dos;ππfunction NOV_GetConnectionNumber:integer;π varπ buf : registers;π beginπ buf.AH:=$DC;π intr($21,buf);π NOV_GetConnectionNumber:=buf.AL;π end;ππprocedure NOV_GetConnectionInformation(connection:byte; varπResult:ConnectionInfo);π varπ buf : registers;π req : CnxnInfoREQUEST;π rep : CnxnInfoREPLY;π beginπ with buf doπ beginπ AH:=$E3;π DS:=seg(req);π SI:=ofs(req);π ES:=seg(rep);π DI:=ofs(rep);π end;π with req doπ beginπ ReqBuffLen := Sizeof(req)-2;π Mask := $16;π CnxnNo := Connection;π end;π fillchar(rep,sizeof(rep),0);π rep.RepBuffLen:=Sizeof(rep)-2;π intr($21,buf);π Result:=rep.data;π end;ππend.πππ
